home *** CD-ROM | disk | FTP | other *** search
/ SGI Hot Mix 17 / Hot Mix 17.iso / HM17_SGI / research / lib / extrac.pro < prev    next >
Text File  |  1997-07-08  |  14KB  |  423 lines
  1. ; $Id: extrac.pro,v 1.4 1997/01/15 03:11:50 ali Exp $
  2. ;
  3. ; Copyright (c) 1989-1997, Research Systems, Inc.  All rights reserved.
  4. ;    Unauthorized reproduction prohibited.
  5. ;
  6.  
  7. function EXTRAC, Array, P0,P1,P2,P3,P4,P5,P6,P7,P8,P9,P10,P11,P12,P13,P14,P15
  8. ;+
  9. ; NAME:
  10. ;    EXTRAC
  11. ;
  12. ; PURPOSE:
  13. ;    The EXTRAC function returns as its result any rectangular sub-matrix
  14. ;    or portion of the parameter array.  When parts of the specified
  15. ;    subsection lie outside the bounds of the array, zeros are
  16. ;    entered into these outlying elements.
  17. ;
  18. ;    EXTRAC was originally a built-in system procedure in the PDP-11
  19. ;    version of IDL, and was retained in that form in the original VAX/VMS
  20. ;    IDL for compatibility.  Most applications of the EXTRAC function
  21. ;    are more concisely written using subscript ranges (e.g., X(10:15)).  In
  22. ;    the current release of IDL, EXTRAC has been rewritten as a User Library
  23. ;    function that provides the same interface as the previous versions.
  24. ;
  25. ; CATEGORY:
  26. ;    Array Manipulation.
  27. ;
  28. ; CALLING SEQUENCE:
  29. ;    Result = EXTRAC(Array, C1, C2, ..., Cn, S1, S2, ..., Sn)
  30. ;
  31. ; INPUTS:                 
  32. ;    Array:    The array from which the subarray will be copied.
  33. ;
  34. ;    Ci:    The starting subscript in Array for the subarray. There
  35. ;        should be one Ci for each dimension of Array.
  36. ;
  37. ;    Si:    The size of each dimension.  The result will have dimensions
  38. ;        of (S1, S2, ..., Sn). There should be one Si for each
  39. ;        dimension of Array.
  40. ;
  41. ; OUTPUTS:
  42. ;    This function returns a two-dimensional, floating-point,
  43. ;    interpolated array.
  44. ;
  45. ; RESTRICTIONS:
  46. ;    In order to make the most typical cases run quickly, little error 
  47. ;    checking is done on the input.  In particular, the Ci and Si arguments
  48. ;    must all be scalar integers, and the Si must be non-negative.
  49. ;
  50. ;    If you know that the subarray will never lie beyond the edges of
  51. ;    the array, it is more efficient to use array subscript ranges
  52. ;    to extract the data instead of EXTRAC. 
  53. ;
  54. ; PROCEDURE:
  55. ;    If the subarray lies entirely inside the Array argument, the
  56. ;    standard array subscript-range mechanism is used to do the work.
  57. ;    Otherwise, a zeroed array of the correct type and size is
  58. ;    created, and the overlapping subarray is copied into it.
  59. ;
  60. ; EXAMPLES:
  61. ;    EXAMPLE 1:
  62. ;    Define a 1000 point vector with each element initialized to
  63. ;    its subscript.  Extract a 300 pt. vector, starting at A(200) and
  64. ;    going to A(499).  B(0) will be equal to A(200), B(299) will be
  65. ;    equal to A(499).  Enter:
  66. ;
  67. ;        A = FINDGEN(1000)
  68. ;        B = EXTRAC(A, 200, 300)
  69. ;
  70. ;    EXAMPLE 2:
  71. ;    Here, the first 49 points extracted (B(0) to B(49)) lie outside
  72. ;    the bounds of the vector and are set to 0.  B(50) is set to A(0),
  73. ;    B(51) is set to A(1) which is 1, ... Enter:
  74. ;
  75. ;        A = FINDGEN(1000)
  76. ;        B = EXTRAC(A, -50, 100)
  77. ;
  78. ;    EXAMPLE 3:
  79. ;    The following commands illustrate the use of EXTRAC with multi-
  80. ;    dimensional arrays.  Enter:
  81. ;
  82. ;        A = INTARR(64,64)    ;Make a 64X64 matrix to play with
  83. ;
  84. ;    Take out a 32X32 portion starting at A(20,30) by entering:
  85. ;
  86. ;        B = EXTRAC(A, 20, 30, 32, 32)
  87. ;
  88. ;    A better way to perform the same operation as the previous line is:
  89. ;
  90. ;        B = A(20:51, 30:61)
  91. ;
  92. ;    Extract the 20th column and 32nd row of A:
  93. ;
  94. ;        B = EXTRAC(A, 19, 0, 1, 64)    ; Extract 20th column of A
  95. ;        B = EXTRAC(A, 0, 31, 64, 1)    ; Extract 32nd row of A
  96. ;
  97. ;    Take a 32X32 matrix from A starting at A(40,50).
  98. ;
  99. ;        B = EXTRAC(A, 40, 50, 32, 32)
  100. ;
  101. ;    NOTE: Those points beyond the boundaries of A are set to 0.
  102. ;
  103. ; REVISION HISTORY:
  104. ;    July 18, 1989    Written AB, RSI
  105. ;-
  106.  
  107. on_error, 2            ; Return to caller on error
  108.  
  109. asize = SIZE(Array)
  110. ndim = asize[0]
  111. orig_dims = asize[1:ndim]
  112.  
  113. ; Is it an array?
  114. if (ndim eq 0) then message, 'Target argument must be an array.'
  115.  
  116. ; Is there an appropriate number of arguments present?
  117. if (n_params() ne (ndim * 2 + 1)) then message, 'Wrong number of arguments.'
  118.  
  119. ; Convert the arguments to a more convenient form.
  120. args = intarr(2 * ndim)
  121. CASE (ndim) of
  122. ; 8: BEGIN & args[15] = P15 & args[14] = P14 & GOTO, do_seven & END
  123.   7: do_seven: BEGIN & args[13] = P13 & args[12] = P12 & GOTO, do_six & END
  124.   6: do_six: BEGIN & args[11] = P11 & args[10] = P10 & GOTO, do_five & END
  125.   5: do_five: BEGIN & args[9] = P9 & args[8] = P8 & GOTO, do_four & END
  126.   4: do_four: BEGIN & args[7] = P7 & args[6] = P6 & GOTO, do_three & END
  127.   3: do_three: BEGIN & args[5] = P5 & args[4] = P4 & GOTO, do_two & END
  128.   2: do_two: BEGIN & args[3] = P3 & args[2] = P2 & GOTO, do_one & END
  129.   1: do_one: BEGIN & args[1] = P1 & args[0] = P0 & END
  130. ENDCASE
  131. srt = args[0:ndim-1]
  132. dims = args[ndim:*]
  133.  
  134. ; Determine if the subarray extends beyond the edges of the original.
  135. ; If not, a simple expression will do the job.
  136. srt_over = where(srt lt 0, s_cnt)
  137. dims_over = where((srt + dims) gt orig_dims, b_cnt)
  138.  
  139. if ((s_cnt eq 0) and (b_cnt eq 0)) then begin
  140.   ; The extracted array does not go beyond the array boundaries. Use the
  141.   ; normal expression to extract the result.
  142.   bnd = dims + srt - 1
  143.   case (ndim) of
  144.     1: result =  Array[P0:bnd[0]]
  145.     2: result =  Array[P0:bnd[0],P1:bnd[1]]
  146.     3: result =  Array[P0:bnd[0],P1:bnd[1],P2:bnd[2]]
  147.     4: result =  Array[P0:bnd[0],P1:bnd[1],P2:bnd[2],P3:bnd[3]]
  148.     5: result =  Array[P0:bnd[0],P1:bnd[1],P2:bnd[2],P3:bnd[3],P4:bnd[4]]
  149.     6: result =  Array[P0:bnd[0],P1:bnd[1],P2:bnd[2],P3:bnd[3],P4:bnd[4], $
  150.                P5:bnd[5]]
  151.     7: result =  Array[P0:bnd[0],P1:bnd[1],P2:bnd[2],P3:bnd[3],P4:bnd[4], $
  152.                P5:bnd[5],P6:bnd[6]]
  153. ;   8: result =  Array[P0:bnd[0],P1:bnd[1],P2:bnd[2],P3:bnd[3],P4:bnd[4], $
  154. ;               P5:bnd[5],P6:bnd[6],P7:bnd[7]]
  155.    endcase
  156.   goto, done
  157. endif
  158.  
  159. ; If we get this far, the sub array extends beyond the source array
  160. ; dimensions. Get a zeroed array of the correct type and extract the
  161. ; non-zero part of the original into it.
  162. result = make_array(type=asize[ndim + 1], dimension=dims)  ; Get a result array
  163.  
  164. ; Determine the insertion point for the subarray.
  165. isrt = intarr(ndim)
  166. if (s_cnt ne 0) then isrt[srt_over] = abs(srt[srt_over])
  167.  
  168.  
  169. ; If any of the starting points exceed the dimensions, then we're done.
  170. dims_over = where(isrt ge dims, b_cnt)
  171. srt_over = where(srt ge orig_dims, s_cnt)
  172. if ((b_cnt ne 0) or (s_cnt ne 0)) then goto, done
  173.  
  174. ; Determine the size of the subarray to be inserted. This is the
  175. ; lesser of the original size and the room for insertion in the target.
  176. ;
  177. ; dims - isrt is the availible room in the result array
  178. ; orig_dims - srt - is the largest possible subarray we can pull out of ARRAY
  179.  
  180. t1 = dims - isrt
  181. bnd = (t1 < (orig_dims - srt)) < t1    ; Minimum of the two sizes
  182. srt = srt > 0                ; Clip starting point to non-negative
  183. bnd = srt + bnd - 1            ; Calcualte the actual outer boundary
  184.  
  185. ; Insert the subarray from ARRAY into RESULT
  186. case (ndim) of
  187.   1: result[isrt[0]] =  Array[srt[0]:bnd[0]]
  188.   2: result[isrt[0],isrt[1]] =  Array[srt[0]:bnd[0],srt[1]:bnd[1]]
  189.   3: result[isrt[0],isrt[1],isrt[2]] = Array[srt[0]:bnd[0],srt[1]:bnd[1],srt[2]:bnd[2]]
  190.   4: result[isrt[0],isrt[1],isrt[2],isrt[3]] =  $
  191.     Array[srt[0]:bnd[0],srt[1]:bnd[1],srt[2]:bnd[2],srt[3]:bnd[3]]
  192.   5: result[isrt[0],isrt[1],isrt[2],isrt[3],isrt[4]] =  $
  193.     Array[srt[0]:bnd[0],srt[1]:bnd[1],srt[2]:bnd[2],srt[3]:bnd[3], $
  194.           srt[4]:bnd[4]]
  195.   6: result[isrt[0],isrt[1],isrt[2],isrt[3],isrt[4],isrt[5]] = $
  196.     Array[srt[0]:bnd[0],srt[1]:bnd[1],srt[2]:bnd[2],srt[3]:bnd[3], $
  197.           srt[4]:bnd[4], srt[5]:bnd[5]]
  198.   7: result[isrt[0],isrt[1],isrt[2],isrt[3],isrt[4],isrt[5],isrt[6]] = $
  199.     Array[srt[0]:bnd[0],srt[1]:bnd[1],srt[2]:bnd[2],srt[3]:bnd[3], $
  200.           srt[4]:bnd[4], srt[5]:bnd[5],srt[6]:bnd[6]]
  201. ; 8: result[isrt[0],isrt[1],isrt[2],isrt[3],isrt[4],isrt[5],isrt[6],isrt[7]]= $
  202. ;    Array[srt[0]:bnd[0],srt[1]:bnd[1],srt[2]:bnd[2],srt[3]:bnd[3], $
  203. ;          srt[4]:bnd[4], srt[5]:bnd[5],srt[6]:bnd[6],srt[7]:bnd[7]]
  204. endcase
  205.  
  206.  
  207. done:
  208.   return, result
  209. end
  210.  
  211.  
  212.  
  213.  
  214.  
  215.  
  216.  
  217. ; The rest of this file exists in order to test the EXTRAC procedure above.
  218. ; Normally, it won't be compiled when EXTRAC is used because when
  219. ; a procedure is automatically pulled out of the user library, only
  220. ; enough is compiled to get the desired routine, the rest of the file
  221. ; is ignored. Use ".run extrac" to compile everything.
  222.  
  223.  
  224. pro extrac_errprint, n, is, want
  225. ; extrac_errprint tests a result against the desired value and
  226. ; reports it if they don't agree
  227. ;
  228. ; entry:
  229. ;    n - Error identification number.
  230. ;    is - Result value.
  231. ;    want - Correct value for is.
  232. ;
  233. ; exit:
  234. ;    if (is eq want) then errprint returns quietly. Otherwise,
  235. ;    it sends a report to stderr.
  236. ;
  237. if (size(is))[0] eq 0 then begin
  238.   if is ne want then begin
  239.     printf,-2,format='($,"ERROR(",a,"): ")', strtrim(n,2)
  240.     printf,-2,format='(" is(",a,"), want(",a,")")',is,want
  241.   endif else goto, is_ok
  242. endif else begin
  243.   s = size(is)
  244.   if s[s[0]+1] eq 7 then $    ;Strings?
  245.     x = total(is ne want) $
  246.   else x = total(abs(is-want))
  247.     if x ne 0. then begin
  248.       printf,-2,format='($,"ERROR(",a,"): ")', strtrim(n,2)
  249.       printf,-2,format='(" ARRAY total is(",a,"), want(",a,")")',x,0.0
  250.   endif else goto, is_ok
  251. endelse
  252.  
  253. return
  254.  
  255. is_ok:
  256.   printf, -2, format='("OK(", I0, ")")', n
  257.  
  258. end
  259.  
  260.  
  261.  
  262.  
  263.  
  264.  
  265.  
  266. pro test_extrac
  267. ; Test the EXTRAC procedure. These tests are hardly exhaustive ---
  268. ; especially with dimensions above 2.
  269.  
  270.  
  271.  
  272. ;;;;;;;;;;; PART 1 --- Vector case
  273. a = findgen(10)            ; Test data
  274.  
  275. ; Desired subarray is completely to left of the array
  276. extrac_errprint, 1, extrac[a, -100, 60], fltarr(60)
  277.  
  278. ; Subarray is completely to right of the array
  279. extrac_errprint, 2, extrac[a, 100, 60], fltarr(60)
  280.  
  281. ; Subarray overlaps partly on left
  282. correct = fltarr(10)
  283. correct[5] = a[0:4]
  284. extrac_errprint, 3, extrac[a, -5, 10], correct
  285.  
  286. ; Subarray overlaps partly on right
  287. correct = fltarr(10)
  288. correct[0] = a[5:9]
  289. extrac_errprint, 4, extrac[a, 5, 10], correct
  290.  
  291. ; Border Condition - Just left of array
  292. extrac_errprint, 5, extrac[a, -10, 10], fltarr(10)
  293.  
  294. ; Condition Border - One column overlaps on right
  295. correct = fltarr(10)
  296. correct[9] = a[0]
  297. extrac_errprint, 6, extrac[a, -9, 10], correct
  298.  
  299. ; Border Condition - Just right of array
  300. extrac_errprint, 7, extrac[a, 10, 10], fltarr(10)
  301.  
  302. ; Condition Border - One column overlaps on left
  303. correct = fltarr(10,10)
  304. correct[0] = a[9]
  305. extrac_errprint, 8, extrac[a, 9, 10], correct
  306.  
  307. ; Trivial case --- extract the entire array
  308. extrac_errprint, 9, extrac[a, 0, 10], a
  309.  
  310. ; Extract a completely interior region. This is what the subscript op does
  311. extrac_errprint, 10, extrac[a, 2, 5], a[2:6]
  312.  
  313.  
  314. ;;;;;;;;;;; PART 2 --- 2D case
  315.  
  316.  
  317. a = findgen(10,10)        ; Test data
  318.  
  319. ; Desired subarray is completely below the array
  320. extrac_errprint, 11, extrac[a, -100, -100, 60, 60], fltarr(60, 60)
  321.  
  322. ; Subarray is completely above the array
  323. extrac_errprint, 12, extrac[a, 100, 100, 60, 60], fltarr(60, 60)
  324.  
  325. ; Subarray overlaps partly on left
  326. correct = fltarr(10,10)
  327. correct[5,0] = a[0:4, 0:*]
  328. extrac_errprint, 13, extrac[a, -5, 0, 10, 10], correct
  329.  
  330. ; Subarray overlaps partly on right
  331. correct = fltarr(10,10)
  332. correct[0,0] = a[5:9, 0:*]
  333. extrac_errprint, 14, extrac[a, 5, 0, 10, 10], correct
  334.  
  335. ; Subarray overlaps partly on top
  336. correct = fltarr(10,10)
  337. correct[0,5] = a[0:*, 0:4]
  338. extrac_errprint, 15, extrac[a, 0, -5, 10, 10], correct
  339.  
  340. ; Subarray overlaps partly on bottom
  341. correct = fltarr(10,10)
  342. correct[0,0] = a[*, 5:9]
  343. extrac_errprint, 16, extrac[a, 0, 5, 10, 10], correct
  344.  
  345. ; Border Condition - Just left of array
  346. extrac_errprint, 17, extrac[a, -10, 0, 10, 10], fltarr(10,10)
  347.  
  348. ; Condition Border - One column overlaps on right
  349. correct = fltarr(10,10)
  350. correct[9,0] = a[0,*]
  351. extrac_errprint, 18, extrac[a, -9, 0, 10, 10], correct
  352.  
  353. ; Border Condition - Just right of array
  354. extrac_errprint, 19, extrac[a, 10, 0, 10, 10], fltarr(10,10)
  355.  
  356. ; Condition Border - One column overlaps on left
  357. correct = fltarr(10,10)
  358. correct[0,0] = a[9,*]
  359. extrac_errprint, 20, extrac[a, 9, 0, 10, 10], correct
  360.  
  361. ; Trivial case --- extract the entire array
  362. extrac_errprint, 21, extrac[a, 0, 0, 10, 10], a
  363.  
  364. ; Extract a completely interior region. This is what the subscript op does
  365. extrac_errprint, 22, extrac[a, 2, 3, 5, 6], a[2:6,3:8]
  366.  
  367.  
  368.  
  369. ;;;;;;;;;;; PART 3 --- 3D case
  370.  
  371.  
  372. a = findgen(10,10,10)        ; Test data
  373.  
  374. ; Desired subarray is completely below the array
  375. extrac_errprint, 23, extrac[a,-100,-100,-100,60,60,60], fltarr(60,60,60)
  376.  
  377. ; Subarray is completely above the array
  378. extrac_errprint, 24, extrac[a, 100, 100, 100, 60, 60, 60], fltarr(60,60,60)
  379.  
  380. ; Subarray overlaps partly on left
  381. correct = fltarr(10,10,10)
  382. correct[5,0,0] = a[0:4, 0:*, 0:*]
  383. extrac_errprint, 25, extrac[a, -5, 0, 0, 10, 10, 10], correct
  384.  
  385. ; Subarray overlaps partly on right
  386. correct = fltarr(10,10,10)
  387. correct[0,0,0] = a[5:9, 0:*, 0:*]
  388. extrac_errprint, 26, extrac[a, 5, 0, 0, 10, 10, 10], correct
  389.  
  390. ; Subarray overlaps partly on top
  391. correct = fltarr(10,10,10)
  392. correct[0,5,0] = a[0:*, 0:4, 0:*]
  393. extrac_errprint, 27, extrac[a, 0, -5, 0, 10, 10, 10], correct
  394.  
  395. ; Subarray overlaps partly on bottom
  396. correct = fltarr(10,10,10)
  397. correct[0,0,0] = a[*, 5:9,*]
  398. extrac_errprint, 28, extrac[a, 0, 5, 0, 10, 10, 10], correct
  399.  
  400. ; Border Condition - Just left of array
  401. extrac_errprint, 29, extrac[a, -10, 0, 0, 10, 10, 10], fltarr(10,10,10)
  402.  
  403. ; Condition Border - One column overlaps on right
  404. correct = fltarr(10,10,10)
  405. correct[9,0,0] = a[0,*,*]
  406. extrac_errprint, 30, extrac[a, -9, 0, 0, 10, 10, 10], correct
  407.  
  408. ; Border Condition - Just right of array
  409. extrac_errprint, 31, extrac[a, 10, 0, 0, 10, 10, 10], fltarr(10,10,10)
  410.  
  411. ; Condition Border - One column overlaps on left
  412. correct = fltarr(10,10,10)
  413. correct[0,0,0] = a[9,*,*]
  414. extrac_errprint, 32, extrac[a, 9, 0, 0, 10, 10, 10], correct
  415.  
  416. ; Trivial case --- extract the entire array
  417. extrac_errprint, 33, extrac[a, 0, 0, 0, 10, 10, 10], a
  418.  
  419. ; Extract a completely interior region. This is what the subscript op does
  420. extrac_errprint, 34, extrac[a, 2, 3, 4, 5, 6, 7], a[2:6,3:8,4:9]
  421.  
  422. end
  423.